Unit BSCGIServerUnit;

{$mode objfpc}{$H+}
{$interfaces corba}

Interface

Uses
  Classes, SysUtils, strutils, fgl, lNet, BRequestUnit,
    BRequestHandlerUnit, BCustomSessionUnit, syncobjs;

Type BRequestHandlersList = Specialize TFPGList<BRequestHandlerClass>;
Type BRequestHandlersThreadList = TThreadList;

Type

{ BRequestHandlersPoolClass }

 BRequestHandlersPoolClass = Class
  Private
    bPool: BRequestHandlersThreadList;
  Public
    Function GetFreeHandler(Const aRequest: BRequestClass): Boolean;
    Constructor Build(Const aPoolDepth: Integer;
      Const aProtoSession: BCustomSessionClass);
    Destructor Burn;
End;

Type

{ BSCGIServerClass }

 BSCGIServerClass = Class
  Private
    bSection: TCriticalSection;
    bConnection: TLTcp;
    bPool: BRequestHandlersPoolClass;
    bQueue: BRequestsList;

    Procedure ProcessReceive(aSocket: TLSocket);
    Procedure ProcessError(Const aMessage: String; aSocket: TLSocket);
    Procedure ProcessDisconnect(aSocket: TLSocket);
    Procedure ProcessAccept(aSocket: TLSocket);

    Procedure QueueRequest(Const aRequest: BRequestClass);

  Public
    Procedure Run(Const aPort: Integer = 7448);
    Constructor Build(Const aPoolDepth: Integer;
      Const aProtoSession: BCustomSessionClass);
    Destructor Burn;
End;

Implementation

{ BRequestHandlersPoolClass }

Function BRequestHandlersPoolClass.GetFreeHandler(
 Const aRequest: BRequestClass): Boolean;
Var
 i: Integer;
Begin
  Result := FALSE;
  Repeat
    With bPool.LockList Do
     For i := 0 To Count - 1 Do
       If BRequestHandlerClass(Items[i]).IsFree Then
         Begin
           BRequestHandlerClass(Items[i]).TryHandle(aRequest);
           Result := TRUE;
           Break;
         End;
    bPool.UnlockList;
  Until Result;
End;

Constructor BRequestHandlersPoolClass.Build(Const aPoolDepth: Integer;
 Const aProtoSession: BCustomSessionClass);
Var
 i: Integer;
Begin
  bPool := BRequestHandlersThreadList.Create;
  For i := 0 To aPoolDepth - 1 Do
    bPool.Add(BRequestHandlerClass.Build(i, aProtoSession));
End;

Destructor BRequestHandlersPoolClass.Burn;
Begin

End;

{ BSCGIServerClass }

Procedure BSCGIServerClass.ProcessReceive(aSocket: TLSocket);
Var
  aRequest: BRequestClass;
  aBuffer: String;
Begin
  aSocket.GetMessage(aBuffer);
  If Not(aBuffer  = '') Then
    Begin
      aRequest := BRequestClass.Build(aSocket);
      If Not(aRequest.ParseRequest(aBuffer) And
        bPool.GetFreeHandler(aRequest)) Then
          aRequest.Burn;
    End;
End;

Procedure BSCGIServerClass.ProcessError(Const aMessage: String;
  aSocket: TLSocket);
Begin
End;

Procedure BSCGIServerClass.ProcessDisconnect(aSocket: TLSocket);
Begin
End;

Procedure BSCGIServerClass.ProcessAccept(aSocket: TLSocket);
Begin

End;

Procedure BSCGIServerClass.QueueRequest(Const aRequest: BRequestClass);
Begin
  bQueue.Add(aRequest);
End;

Procedure BSCGIServerClass.Run(Const aPort: Integer);
Var
  aTermintaed: Boolean = FALSE;
Begin
  If bConnection.Listen(aPort) Then
    Repeat
      bConnection.CallAction;
    Until aTermintaed;
End;

Constructor BSCGIServerClass.Build(Const aPoolDepth: Integer;
  Const aProtoSession: BCustomSessionClass);
Begin
  Randomize;

  bPool := BRequestHandlersPoolClass.Build(aPoolDepth, aProtoSession);
  bSection := TCriticalSection.Create;

  bConnection := TLTcp.Create(nil);
  bConnection.Timeout := 100;
  bConnection.ReuseAddress := TRUE;

  bConnection.OnAccept := @ProcessAccept;
  bConnection.OnError := @ProcessError;
  bConnection.OnDisconnect := @ProcessDisconnect;
  bConnection.OnReceive := @ProcessReceive;
End;

Destructor BSCGIServerClass.Burn;
Begin
  bSection.Free;
End;

End.

